home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
New Star Software Collection
/
NSS_Collection.iso
/
3-004 ms visual basic pro 30
/
4.imz
/
4.IMA
/
DYNASET.FR_
/
DYNASET.bin
Wrap
Text File
|
1993-04-28
|
29KB
|
1,112 lines
VERSION 2.00
Begin Form fDynaset
BackColor = &H00C0C0C0&
ClientHeight = 3750
ClientLeft = 1410
ClientTop = 2415
ClientWidth = 5655
Height = 4155
Icon = DYNASET.FRX:0000
KeyPreview = -1 'True
Left = 1350
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3733.906
ScaleMode = 0 'User
ScaleWidth = 5675.317
Tag = "Dynaset"
Top = 2070
Width = 5775
Begin PictureBox FieldHeader
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 0
ScaleHeight = 240
ScaleMode = 0 'User
ScaleWidth = 5028
TabIndex = 16
Top = 480
Width = 5025
Begin Label FieldValueLabel
BackColor = &H00C0C0C0&
Caption = " Value (F4=Zoom) "
Height = 255
Left = 1680
TabIndex = 18
Top = 0
Width = 3165
End
Begin Label FieldHdrLabel
BackColor = &H00C0C0C0&
Caption = "Field Name:"
Height = 252
Left = 120
TabIndex = 17
Top = 0
Width = 1212
End
End
Begin PictureBox ViewButtons
Align = 1 'Align Top
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 495
Left = 0
ScaleHeight = 495
ScaleMode = 0 'User
ScaleWidth = 5658.376
TabIndex = 0
Top = 0
Width = 5655
Begin CommandButton SortButton
Caption = "&Sort"
Height = 330
Left = 3128
TabIndex = 24
Top = 0
Width = 650
End
Begin CommandButton FilterButton
Caption = "F&ilter"
Height = 330
Left = 2520
TabIndex = 23
Top = 0
Width = 650
End
Begin CommandButton CloseButton
Cancel = -1 'True
Caption = "&Close"
Height = 330
Left = 4367
TabIndex = 9
TabStop = 0 'False
Top = 0
Width = 650
End
Begin CommandButton PropButton
Caption = "&Prop"
Height = 330
Left = 3738
TabIndex = 5
Top = 0
Width = 650
End
Begin CommandButton DelButton
Caption = "&Del"
Height = 330
Left = 1260
TabIndex = 4
Top = 0
Width = 650
End
Begin CommandButton EditButton
Caption = "&Edit"
Height = 330
Left = 630
TabIndex = 3
Top = 0
Width = 650
End
Begin CommandButton AddButton
Caption = "&Add"
Height = 330
Left = 0
TabIndex = 2
Top = 0
Width = 650
End
Begin CommandButton FindButton
Caption = "&Find"
Height = 330
Left = 1890
TabIndex = 1
Top = 0
Width = 650
End
End
Begin PictureBox ChangeButtons
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 480
Left = 0
ScaleHeight = 480
ScaleMode = 0 'User
ScaleWidth = 5028
TabIndex = 6
Top = 0
Visible = 0 'False
Width = 5028
Begin CommandButton UpdateButton
Caption = "&Update"
Height = 372
Left = 960
TabIndex = 8
Top = 48
Width = 1212
End
Begin CommandButton CancelButton
Caption = "&Cancel"
Height = 372
Left = 2640
TabIndex = 7
Top = 48
Width = 1212
End
End
Begin PictureBox StatBox
Align = 2 'Align Bottom
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 281
Left = 0
ScaleHeight = 298.153
ScaleMode = 0 'User
ScaleWidth = 5665.189
TabIndex = 14
Top = 3465
Width = 5655
Begin CommandButton NextButton
Caption = ">"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 287
Left = 4200
TabIndex = 22
Top = 0
Width = 375
End
Begin CommandButton LastButton
Caption = ">|"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 287
Left = 4575
TabIndex = 21
Top = 0
Width = 375
End
Begin CommandButton FirstButton
Caption = "|<"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 287
Left = 0
TabIndex = 20
Top = 0
Width = 375
End
Begin CommandButton PrevButton
Caption = "<"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 287
Left = 375
TabIndex = 19
Top = 0
Width = 375
End
Begin Label cStatusBar
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Height = 287
Left = 749
TabIndex = 15
Top = 5
Width = 3360
End
End
Begin VScrollBar cScrollBar
Height = 2616
LargeChange = 3000
Left = 5040
SmallChange = 300
TabIndex = 13
Top = 720
Visible = 0 'False
Width = 252
End
Begin PictureBox cFields
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 375
Left = 120
ScaleHeight = 372
ScaleMode = 0 'User
ScaleWidth = 4812
TabIndex = 10
Top = 720
Width = 4815
Begin TextBox cFieldData
BackColor = &H00FFFFFF&
DataSource = "Data1"
ForeColor = &H00000000&
Height = 288
Index = 0
Left = 1560
TabIndex = 11
Top = 0
Visible = 0 'False
Width = 3252
End
Begin Label cFieldName
BackColor = &H00C0C0C0&
ForeColor = &H00000000&
Height = 252
Index = 0
Left = 0
TabIndex = 12
Top = 60
Visible = 0 'False
Width = 1572
End
End
End
Option Explicit
'form variables
Dim FDS As dynaset 'current form's dynaset
Dim FTblName As String 'form dynaset table name
Dim FBM As String 'form bookmark
Dim FNotFound As Integer 'used by find function
Dim FAtTop As Integer 'top flag
Dim FEditFlag As Integer 'edit mode
Dim FAddNewFlag As Integer 'add mode
Dim FFldDataChanged As Integer
Dim FFindForm As New fFind 'find form instance
Dim FCurrRec As Integer 'record counter
Dim FNumbRows As Long 'total rows in dynaset
Dim FDynaString As String 'dynaset open string
Sub AddButton_Click ()
On Error GoTo AddErr
'set the mode
FDS.AddNew
cStatusBar = "Add record"
FAddNewFlag = True
If FDS.RecordCount > 0 Then
FBM = FDS.Bookmark
Else
FBM = ""
End If
ChangeButtons.Visible = True
ViewButtons.Visible = False
NextButton.Enabled = False
FirstButton.Enabled = False
LastButton.Enabled = False
PrevButton.Enabled = False
ClearDataFields
cFieldData(0).SetFocus
GoTo AddEnd
AddErr:
ShowError
Resume AddEnd
AddEnd:
End Sub
Sub CancelButton_Click ()
On Error Resume Next
ChangeButtons.Visible = False
ViewButtons.Visible = True
NextButton.Enabled = True
FirstButton.Enabled = True
LastButton.Enabled = True
PrevButton.Enabled = True
FEditFlag = False
FAddNewFlag = False
If FBM <> "" Then FDS.Bookmark = FBM
DisplayCurrentRecord
End Sub
Sub cFieldData_Change (Index As Integer)
'just set the flag if data is changed
'it gets reset to false when a new record is displayed
FFldDataChanged = True
End Sub
Sub cFieldData_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = &H73 Then 'F4
cFieldName_DblClick Index
ElseIf KeyCode = 34 And cScrollBar.Visible = True Then
'pagedown with > 10 fields
cScrollBar = cScrollBar - 3000
ElseIf KeyCode = 33 And cScrollBar.Visible = True Then
'pageup with > 10 fields
cScrollBar = cScrollBar + 3000
End If
End Sub
Sub cFieldData_KeyPress (Index As Integer, KeyAscii As Integer)
'only allow return when in edit of add mode
If FEditFlag = True Or FAddNewFlag = True Then
If FDS(Index).Type = FT_STRING And Len(cFieldData(Index)) > FDS(Index).Size Then
Beep
MsgBox "Field Length Exceeded!", 48
KeyAscii = 0
Exit Sub
End If
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
'throw away the keystrokes if not in add or edit mode
ElseIf FEditFlag = False And FAddNewFlag = False Then
KeyAscii = 0
End If
End Sub
Sub cFieldData_LostFocus (Index As Integer)
On Error GoTo FldDataErr
If FFldDataChanged = True Then
'store the data in the field
FDS(Index) = cFieldData(Index)
End If
GoTo FldDataEnd
FldDataErr:
ShowError
Resume FldDataEnd
FldDataEnd:
'reset for valid or error condition
FFldDataChanged = False
End Sub
Sub cFieldName_DblClick (Index As Integer)
On Error GoTo ZoomErr
If FDS(Index).Type = FT_STRING Or FDS(Index).Type = FT_MEMO Then
If FDS(Index).FieldSize() < GETCHUNK_CUTOFF Then
gstZoomData = cFieldData(Index)
Else
'add the rest of the field data with getchunk
MsgBar "Getting Memo Field Data", True
SetHourglass Me
gstZoomData = cFieldData(Index) + StripNonAscii(FDS(Index).GetChunk(GETCHUNK_CUTOFF, MAX_MEMO_SIZE))
ResetMouse Me
MsgBar "", False
End If
fZoom.Caption = Mid(cFieldName(Index), 1, Len(cFieldName(Index)) - 1)
fZoom.Top = Top + 1200
fZoom.Left = Left + 250
If FAddNewFlag Or FEditFlag Then
fZoom.SaveButton.Visible = True
fZoom.CloseButton.Visible = True
Else
fZoom.CloseZoomButton.Visible = True
End If
fZoom.Show MODAL
If FAddNewFlag Or FEditFlag Then
If FDS(Index).Type = FT_STRING And Len(gstZoomData) > FDS(Index).Size Then
Beep
MsgBox "Field Length Exceeded, Data Truncated!", 48
cFieldData(Index) = Mid(gstZoomData, 1, FDS(Index).Size)
Else
cFieldData(Index) = gstZoomData
End If
FDS(Index) = cFieldData(Index)
FFldDataChanged = False
End If
End If
GoTo ZoomEnd
ZoomErr:
ShowError
Resume ZoomEnd
ZoomEnd:
End Sub
Sub ClearDataFields ()
Dim i As Integer
'clear out the fields on the main form
For i = 0 To FDS.Fields.Count - 1
cFieldData(i) = ""
Next
End Sub
Sub CloseButton_Click ()
Unload Me
End Sub
Sub cScrollBar_Change ()
Dim t As Integer
t = cScrollBar
If (t - 720) Mod 300 = 0 Then
cFields.Top = t
Else
cFields.Top = ((t - 720) \ 300) * 300 + 720
End If
End Sub
Sub DelButton_Click ()
On Error GoTo DelRecErr
If MsgBox("Delete Current Record?", MSGBOX_TYPE) = YES Then
FDS.Delete
If gfTransPending Then gfDBChanged = True
If FDS.EOF = False Then
FDS.MoveNext
End If
FNumbRows = FNumbRows - 1
DisplayCurrentRecord
End If
GoTo DelRecEnd
DelRecErr:
ShowError
Resume DelRecEnd
DelRecEnd:
End Sub
Sub DisplayCurrentRecord ()
Dim i As Integer
Dim cst As String 'current status bar
On Error GoTo DCRErr
SetHourglass Me
cst = "Record "
'check BOF/EOF flag so we know if we
'are sitting on a valid record
If FAddNewFlag = True Then
cst = cst + CStr(FCurrRec) + " of " + CStr(FNumbRows)
Else
If FDS.BOF = True Then
cst = cst + "(BOF) of " + CStr(FNumbRows)
ClearDataFields
ElseIf FDS.EOF = True Then
cst = cst + "(EOF) of " + CStr(FNumbRows)
ClearDataFields
Else
cst = cst + CStr(FCurrRec) + " of " + CStr(FNumbRows)
'place the data in the form fields
For i = 0 To FDS.Fields.Count - 1
If FDS(i).Type = FT_MEMO Then
If FDS(i).FieldSize() < GETCHUNK_CUTOFF Then
cFieldData(i) = StripNonAscii(vFieldVal(FDS(i)))
Else
cFieldData(i) = StripNonAscii(vFieldVal(FDS(i).GetChunk(0, GETCHUNK_CUTOFF)))
End If
ElseIf FDS(i).Type = FT_STRING Then
cFieldData(i) = StripNonAscii(vFieldVal(FDS(i)))
Else
cFieldData(i) = vFieldVal(FDS(i))
End If
Next
End If
End If
If gfUpdatable = False Then cst = cst + " [Not Updatable]"
cStatusBar = cst
'set the flag
FFldDataChanged = False
GoTo DCREnd
DCRErr:
ShowError
Resume DCREnd
DCREnd:
ResetMouse Me
End Sub
Sub EditButton_Click ()
On Error GoTo EditErr
FDS.Edit
cStatusBar = "Edit record"
FEditFlag = True
cFieldData(0).SetFocus
FBM = FDS.Bookmark
ChangeButtons.Visible = True
ViewButtons.Visible = False
NextButton.Enabled = False
FirstButton.Enabled = False
LastButton.Enabled = False
PrevButton.Enabled = False
GoTo EditEnd
EditErr:
ShowError
Resume EditEnd
EditEnd:
End Sub
Sub FilterButton_Click ()
On Error GoTo FilterErr
Dim bm As String
Dim ds1 As dynaset, ds2 As dynaset
Dim FilterStr As String
bm = FDS.Bookmark 'save the bookmark
Set ds1 = FDS 'save the dynaset
FilterStr = InputBox("Enter Filter Expression:")
If FilterStr = "" Then Exit Sub
SetHourglass Me
MsgBar "Setting New Filter", True
FDS.Filter = FilterStr
Set ds2 = FDS.CreateDynaset() 'establish the filter
Set FDS = ds2 'assign back to original dynaset object
'everything must be okay so redisplay form on 1st record
FNumbRows = GetNumbRecs(FDS) 'query numb of recs
FCurrRec = 1
DisplayCurrentRecord 'display field values
FAtTop = True
ResetMouse Me
MsgBar "", False
GoTo FilterEnd
FilterErr:
ResetMouse Me
MsgBar "", False
ShowError
Set FDS = ds1 're-assign back to original
FDS.Bookmark = bm 'go back to original record
Resume FilterEnd
FilterEnd:
End Sub
Sub FindButton_Click ()
Dim i As Integer
Dim bm As String
On Error GoTo FindErr
'load the column names into the find form
If FFindForm.cFieldList.ListCount = 0 Then
For i = 0 To FDS.Fields.Count - 1
FFindForm.cFieldList.AddItem Mid(cFieldName(i), 1, Len(cFieldName(i)) - 1)
Next
End If
FindStart:
'reset the flags
gfFindFailed = False
gfFromTableView = False
FNotFound = False
MsgBar "Enter Search Parameters", False
FFindForm.Show MODAL
MsgBar "Searching for New Record", True
If gfFindFailed = True Then 'find cancelled
GoTo AfterWhile
End If
SetHourglass Me
i = FFindForm.cFieldList.ListIndex
'search for the record
bm = FDS.Bookmark
If FDS(i).Type = FT_STRING Or FDS(i).Type = FT_MEMO Then
FDS.FindFirst FDS(i).Name + " " + gstFindOp + " '" + gstFindExpr + "'"
Else
FDS.FindFirst FDS(i).Name + gstFindOp + gstFindExpr
End If
FNotFound = FDS.NoMatch
AfterWhile:
ResetMouse Me
If gfFindFailed = True Then 'go back to top
FDS.Bookmark = bm
ElseIf FNotFound Then
Beep
MsgBox "Record Not Found", 48
FDS.Bookmark = bm
GoTo FindStart
Else
bm = FDS.Bookmark
FDS.MoveFirst
FCurrRec = 1
While FDS.Bookmark <> bm
FCurrRec = FCurrRec + 1
FDS.MoveNext
Wend
End If
DisplayCurrentRecord
GoTo FindEnd
FindErr:
ResetMouse Me
If Err <> EOF_ERR Then
ShowError
Resume FindEnd
Else
FNotFound = True
Resume Next
End If
FindEnd:
MsgBar "", False
End Sub
Sub FirstButton_Click ()
Dim ds As String
On Error GoTo GoFirstError
FDS.MoveFirst
FCurrRec = 1
DisplayCurrentRecord
FAtTop = True
GoTo GoFirstEnd
GoFirstError:
ShowError
Resume GoFirstEnd
GoFirstEnd:
ResetMouse Me
MsgBar "", False
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
If FEditFlag = True Or FAddNewFlag = True Then Exit Sub
Select Case KeyCode
Case 35 'end
Call LastButton_Click
Case 36 'home
Call FirstButton_Click
Case 38 'up arrow
If Shift = 2 Then
Call FirstButton_Click
Else
Call PrevButton_Click
End If
Case 40 'down arrow
If Shift = 2 Then
Call LastButton_Click
Else
Call NextButton_Click
End If
Case 114 'F3
Call FindButton_Click
End Select
End Sub
Sub Form_Load ()
Dim t As TableDef 'local table structure
Dim sp As Integer 'starting point of table name
Dim ep As Integer 'ending point of table name
Dim ds As String 'temp dynaset name string
Dim wh As String 'where clause
Dim ft As Integer
Dim i As Integer, j As Integer
Dim fn As String 'field name
Dim l As Long
Dim Start1, Finish1, Start2, Finish2
On Error GoTo DynasetErr
SetHourglass Me
MsgBar "Opening Dynaset", True
'disable match case checkbox on find form
'because it isn't implemented on this form
FFindForm.cMatchCase.Enabled = False
'assign the temp string with the select statement
'if it is not empty, otherwise, use the table list name
If gfFromSQL = True Then
If gstDynaString = "" Then
ds = fSQL.cSQLStatement
Else
ds = gstDynaString
End If
ElseIf gstTableDynaFilter <> "" Then
ds = gstTableDynaFilter
Else
ds = fTables.cTableList
End If
'attemp to open the dynaset
Start1 = Timer
If gfFromSQL = True And fSQL.cPassThru = 1 Then
Set FDS = gCurrentDB.CreateDynaset(ds, VBDA_SQLPASSTHROUGH)
Else
Set FDS = gCurrentDB.CreateDynaset(ds)
End If
Finish1 = Timer
Start2 = Timer
'parse off table name to store in global gstTblName
wh = ""
sp = InStr(1, UCase(ds), "FROM")
If sp > 0 Then
'must be a "select from" statement
sp = sp + 5
For ep = sp To Len(ds)
'search for a space or the end of ds
If Mid$(ds, ep, 1) = " " Then
'get where clause if there is one
wh = Mid$(ds, sp, Len(ds) - sp + 1)
Exit For
End If
Next
FTblName = UCase(Mid$(ds, sp, ep - sp))
If wh = "" Then wh = FTblName
Else
'must be a table name only
FTblName = UCase(ds)
wh = FTblName
End If
FDynaString = wh
'show the first record
FNumbRows = GetNumbRecs(FDS) 'query numb of recs
'load the controls on the dynaset form
cFieldName(0).Visible = True
cFieldData(0).Visible = True
ft = FDS(0).Type
cFieldData(0).Width = GetFieldWidth(ft)
cFieldData(0).TabIndex = 0
For i = 1 To FDS.Fields.Count - 1
cFields.Height = cFields.Height + 300
Load cFieldName(i)
cFieldName(i).Top = cFieldName(i - 1).Top + 300
cFieldName(i).Visible = True
Load cFieldData(i)
cFieldData(i).Top = cFieldData(i - 1).Top + 300
cFieldData(i).Visible = True
ft = FDS.Fields(i).Type
cFieldData(i).Width = GetFieldWidth(ft)
cFieldData(i).TabIndex = i
Next
'resize main window
If i <= 10 Then
Height = ((i + 1) * 300) + 1400
Else
Height = 4368
Width = Width + 260
cScrollBar.Visible = True
cScrollBar.Min = 720
cScrollBar.Max = 720 - (i * 300) + 3000
End If
'display the field names
For i = 0 To FDS.Fields.Count - 1
cFieldName(i) = UCase(FDS(i).Name) + ":"
Next
FCurrRec = 1
DisplayCurrentRecord 'display field values
FAtTop = True
If gstTableDynaFilter <> "" Then
Caption = "Filtered Dynaset: " + FTblName
Else
Caption = "Dynaset: " + FTblName
End If
Width = 5805
Left = 1000
Top = 1000
Finish2 = Timer
If VDMDI.PrefShowPerf.Checked Then
Me.Show
MsgBox CStr(FNumbRows) + " rows found in " + CStr(Finish1 - Start1) + " seconds!" + Chr(13) + Chr(10) + CStr(Finish2 - Start2) + " seconds to Get Record Count!", 48
End If
GoTo OkayEnd
DynasetErr:
ShowError
ResetMouse Me
Unload Me
MsgBar "", False
Exit Sub
Resume OkayEnd
OkayEnd:
ResetMouse Me
MsgBar "", False
End Sub
Sub Form_Paint ()
Outlines Me
End Sub
Sub Form_Resize ()
On Error Resume Next
Dim h As Integer, i As Integer
Dim totw As Integer
If WindowState <> 1 Then 'not minimized
MsgBar "Resizing Form", True
'make sure the form is lined up on a field
h = Height
If (h - 1420) Mod 300 <> 0 Then
Height = ((h - 1420) \ 300) * 300 + 1420
End If
'resize the status bar
StatBox.Top = Height - 650
'resize the scrollbar
cScrollBar.Height = StatBox.Top - (ViewButtons.Top - FieldHeader.Height) - 960
cScrollBar.Left = Width - 360
If FDS.Fields.Count > 10 Then
cFields.Width = Width - 260
totw = cScrollBar.Left - 20
Else
cFields.Width = Width - 20
totw = Width - 50
End If
FieldHeader.Width = Width - 20
'widen the fields if possible
For i = 0 To FDS.Fields.Count - 1
cFieldName(i).Width = .3 * totw
cFieldData(i).Left = cFieldName(i).Width + 20
If FDS(i).Type = FT_STRING Or FDS(i).Type = FT_MEMO Then
cFieldData(i).Width = .7 * totw - 250
End If
Next
FieldValueLabel.Left = cFieldData(0).Left
cStatusBar.Width = Width - 1600
NextButton.Left = cStatusBar.Width + 745
LastButton.Left = NextButton.Left + 370
End If
MsgBar "", False
End Sub
Sub Form_Unload (Cancel As Integer)
On Error Resume Next
Unload FFindForm 'get rid of attached find form
FDS.Close 'close the form dynaset
MsgBar "", False
End Sub
Sub LastButton_Click ()
On Error GoTo GoLastError
FDS.MoveLast
'show the current record
FCurrRec = FNumbRows
DisplayCurrentRecord
GoTo GoLastEnd
GoLastError:
ShowError
Resume GoLastEnd
GoLastEnd:
End Sub
Sub NextButton_Click ()
On Error GoTo GoNextError
FDS.MoveNext
'show the current record
FCurrRec = FCurrRec + 1 'bump the record counter
DisplayCurrentRecord
FAtTop = False
GoTo GoNextEnd
GoNextError:
ShowError
Resume GoNextEnd
GoNextEnd:
End Sub
Sub PrevButton_Click ()
On Error GoTo GoPrevError
FDS.MovePrevious
'show the current record
FCurrRec = FCurrRec - 1 'bump the record counter back
DisplayCurrentRecord
FAtTop = False
GoTo GoPrevEnd
GoPrevError:
ShowError
Resume GoPrevEnd
GoPrevEnd:
End Sub
Sub PropButton_Click ()
Dim f As New fDataBox
On Error GoTo DynPropErr
Set gCurrentDS = FDS
f.Caption = "Dynaset Properties"
f.Tag = "DS"
f.cData.AddItem "Name = " + FDS.Name
f.cData.AddItem "BOF Flag = " + stTrueFalse((FDS.BOF))
f.cData.AddItem "BookMark = " + FDS.Bookmark
f.cData.AddItem "BookMarkable Flag = " + stTrueFalse((FDS.Bookmarkable))
f.cData.AddItem "EOF Flag = " + stTrueFalse((FDS.EOF))
f.cData.AddItem "Filter = " + FDS.Filter
f.cData.AddItem "Last Modified = " + FDS.LastModified
f.cData.AddItem "Lock Edits Flag = " + stTrueFalse((FDS.LockEdits))
f.cData.AddItem "No Match Flag = " + stTrueFalse((FDS.NoMatch))
f.cData.AddItem "Sort = " + FDS.Sort
f.cData.AddItem "Transactions Flag = " + stTrueFalse((FDS.Transactions))
f.cData.AddItem "RecordCount = " & FDS.RecordCount
f.cData.AddItem "Updatable Flag = " + stTrueFalse((FDS.Updatable))
f.Show MODAL
GoTo DynPropEnd
DynPropErr:
f.cData.AddItem Error$
Resume Next
DynPropEnd:
End Sub
Sub SortButton_Click ()
On Error GoTo SortErr
Dim bm As String
Dim ds1 As dynaset, ds2 As dynaset
Dim SortStr As String
bm = FDS.Bookmark 'save the bookmark
Set ds1 = FDS 'save the dynaset
SortStr = InputBox("Enter Sort Column:")
If SortStr = "" Then Exit Sub
SetHourglass Me
MsgBar "Setting New Sort Order", True
FDS.Sort = SortStr
Set ds2 = FDS.CreateDynaset() 'establish the Sort
Set FDS = ds2 'assign back to original dynaset object
'everything must be okay so redisplay form on 1st record
FNumbRows = GetNumbRecs(FDS) 'query numb of recs
FCurrRec = 1
DisplayCurrentRecord 'display field values
FAtTop = True
ResetMouse Me
MsgBar "", False
GoTo SortEnd
SortErr:
ResetMouse Me
MsgBar "", False
ShowError
Set FDS = ds1 're-assign back to original
FDS.Bookmark = bm 'go back to original record
Resume SortEnd
SortEnd:
End Sub
Sub UpdateButton_Click ()
On Error GoTo UpdateErr
FDS.Update
If gfTransPending Then gfDBChanged = True
If FAddNewFlag = True Then
FNumbRows = FNumbRows + 1
FCurrRec = FNumbRows
FDS.MoveLast 'move to the new record
End If
ChangeButtons.Visible = False
ViewButtons.Visible = True
NextButton.Enabled = True
FirstButton.Enabled = True
LastButton.Enabled = True
PrevButton.Enabled = True
FEditFlag = False
FAddNewFlag = False
DisplayCurrentRecord
GoTo UpdateEnd
UpdateErr:
ShowError
Resume UpdateEnd
UpdateEnd:
End Sub